home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #09 (Jun 86) / Forth source code / CRT saver < prev    next >
Text File  |  1986-04-07  |  1KB  |  86 lines
  1. ( CRT saver task, © 1986 JL for MacTutor)
  2. only forth definitions
  3. also assembler also mac
  4.  
  5. hex
  6. 904 constant currentA5
  7. 9EE constant grayRgn
  8. 16A constant Ticks
  9.  74 constant screenbits
  10.  10 constant portrect
  11.  
  12. decimal
  13.  
  14. ( first define port structure )
  15. header screenport
  16.      2 allot ( device )
  17.     14 allot ( bitmap )
  18.      8 allot ( portrect   )
  19.     84 allot ( remaining bytes )
  20.  
  21.  
  22. ( *** now define background task that does the blanking *** )
  23.  
  24. variable last.action
  25. variable max.ticks
  26. 3600 max.ticks !  ( 1 minute in ticks )
  27.  
  28. header myevents
  29.     2 allot ( code )
  30.     4 allot ( message )
  31.     4 allot ( when )
  32.     4 allot ( where )
  33.     2 allot ( modifiers )
  34.  
  35. : relevant.action
  36.     138 ( disk + key + mouse ) 
  37.     ['] myevents call EventAvail
  38. ;
  39.  
  40. : redraw
  41.     call drawmenubar
  42.     call frontWindow
  43.     grayRgn @ call paintBehind
  44.     call showcursor
  45. ;
  46.  
  47. : blankout
  48.     call hidecursor
  49.     ['] screenport call openport
  50.     ['] screenport portrect + call paintrect
  51.     BEGIN relevant.action UNTIL
  52.     ticks @ last.action !
  53.     ['] screenport call setport
  54.     redraw 
  55. ;
  56.  
  57. : monitor.events
  58.     activate
  59.     BEGIN
  60.     PAUSE
  61.     relevant.action 
  62.         IF ticks @ last.action ! THEN
  63.     AGAIN
  64. ;
  65.  
  66. : do.blank
  67.     activate
  68.     BEGIN
  69.     PAUSE
  70.     ticks @ last.action @ - max.ticks @ >
  71.         IF blankout THEN
  72.     AGAIN
  73. ;
  74.  
  75. 400 1000 background CRTsaver
  76. CRTsaver build
  77. 400 1000 background eventmonitor
  78. eventmonitor build
  79.  
  80. : saver.start
  81.     ticks @ last.action !
  82.     eventmonitor monitor.events
  83.     CRTsaver do.blank
  84. ;
  85.  
  86.